perm filename PASS2.F4[MU5,LCS] blob sn#107295 filedate 1974-06-18 generic text, type T, neo UTF8
CPASS2     PASS 2 MAIN PROGRAM  
C    *** MUSIC V ***     
      DIMENSIONG(1000),I(1000),T(1000),D(10000),P(100),IP(10)      
      COMMONIP,P,G,I,T,D,IXJQ,TLAST,BLAST     
C     INIALIZING PROGRAM 
C   NOMINAL SAMPLING RATE, NOTE PARAMETER LENGTH, NUMBER OF CARDS  
C   NO OF OP CODES, PASS II REPORT PRINT PARAMETER   
      G(1)=0.     
      G(2)=0.     
      G(4)=10000.0
      NPAR=10000  
      NCAR=1000   
      NOPC=12     
      IXJQ=0      
      IEND=0      
CC*****      NREAD=2     
CC*****      NWRITE=3    
      NREAD=20
      NWRITE=21
      REWIND NREAD
      REWIND NWRITE      
C     INIALIZE SECTION   
 150  ID=1 
      IN=1 
      TLAST=0.    
      BLAST=0.    
C     READ SECTION OF DATA      
  106 CALL READ2(NREAD)  
      I1=IP(1)    
      D(ID)=I1    
      I(IN)=ID    
      T(IN)=P(2)  
      DO 100I2=1,I1
      I3=ID+I2    
 100  D(I3)=P(I2) 
      ID=ID+I1+1  
      IF(ID-NPAR)102,102,101    
 101  CALLERROR(20)      
      STOP 
 102  IN=IN+1     
      IF(IN-NCAR)103,103,101    
 103  IF(P(1)-5.0)104,110,104   
 104  IF(P(1)-6.0)106,105,106   
 105  IEND=1      
      GO TO 110     
C     SORT SECTION
C**** NOT USED ****** 110  CALLSORTFL  
110   IN=IN-1     
      CALLSORT(T(1),T(2),IN,I)  
C     EXECUTE OP CODES M SECTION
 120  DO 1I4=1,IN  
      I5=I(I4)    
      I6=D(I5+1)  
      IF(I6)121,121,122  
 121  CALLERROR(21)      
      GO TO 1
 122  IF(I6-NOPC)123,123,121    
 123  GO TO (2,2,2,2,2,2,7,8,7,10,2,8),I6
 7    CALLERROR(22)      
      GO TO 1
 8    I7=D(I5)    
      I8=I5+4     
      I9=I5+I7    
      I10=IFIX(D(I5+3))-I8      
      DO 124I11=I8,I9     
      I12=I10+I11 
 124  G(I12)=D(I11)      
      IF(I6-12)1,2,1     
 10   I13=D(I5+3) 
      IP(2)=I5    
      IF(I13)125,125,126 
 125  CALLERROR(23)      
      GO TO 1
 126  IF(I13-5)127,127,125      
 127  GO TO (21,22,23,24,25),I13  
 21   CALLPLS1    
      GO TO 1
 22   CALLPLS2    
      GO TO 1
 23   CALLPLS3    
      GO TO 1
 24   CALLPLS4    
      GO TO 1
 25   CALLPLS5    
      GO TO 1
C     WRITE OUT SECTION  
 2    IP(1)=D(I5) 
      I18=IP(1)   
      DO 133I19=1,I18     
      I20=I19+I5  
 133  P(I19)=D(I20)      
      CALL WRITE2 (NWRITE)      
 1    CONTINUE    
C     END SECTION OR PASS
 140  IF(IEND)141,141,143
 141  PRINT142    
  142 FORMAT (' END OF SECTION PASS II')      
      GO TO 150     
 143  PRINT144    
  144 FORMAT (' END OF PASS II')
      STOP 
      END  
CREAD2     PASS 2 DATA INPUT ROUTINE   
C    *** MUSIC V ***     
      SUBROUTINEREAD2(N) 
      DIMENSIONIP(10),P(100)    
      COMMONIP,P  
      READ(N)K,(P(J),J=1,K)     
      IP(1)=K     
      RETURN      
      END  
CSORT SORTING PROGRAM    
C     *** MUSIC V ***    
      SUBROUTINE SORT(A,B,N,L)  
      DIMENSION A(N),L(N)
C   
C     SORT SORTS THE A ARRAY INTO ASCENDING NUMERICAL ORDER, PERFORMING   
C     THE SAME OPERATIONS ON ARRAY L AS ON A  
C   
      N1=N-1      
      DO  10 I=1,N1
      IN=I+1      
      DO  20 J=IN,N
      IF(A(I).LE.A(J))GO TO 20  
      T=A(I)      
      A(I)=A(J)   
      A(J)=T      
      NT=L(I)     
      L(I)=L(J)   
      L(J)=NT     
20    CONTINUE    
10    CONTINUE    
      RETURN      
CC*******      ENTRY SORTFL
CC*******      RETURN      
      END  
CWRIT2     DATA OUTPUTING ROUTINE FOR PASS 2  
C    *** MUSIC V ***     
      SUBROUTINE WRITE2(N)      
      COMMON IP(10),P(100),G(1000),I(1000),T(1000),D(10000),IXJQ,TLAST,B  
     1LAST 
      IF(G(2).EQ.0.)GO TO 150     
      X=P(2)      
      Y=P(4)      
      ILOC=G(2)   
      IF(P(1).NE.1.)GO TO 50      
      P(4)=P(4)*60./CON(G,ILOC,P(2))   
50    P(2)=TLAST+(P(2)-BLAST)*60./CON(G,ILOC,P(2))   
      TLAST=P(2)  
      BLAST=X     
150   CALL CONVT  
      K=IP(1)     
      WRITE(N)K,(P(J),J=1,K)    
C     *** PASS II REPORT IS OPTIONAL ***      
      IF(G(1).NE.0.)RETURN      
      IF(IXJQ.EQ.0)PRINT100     
      IXJQ=10     
100   FORMAT(15H1PASS II REPORT/11H0(WORD CNT))      
      PRINT101,K,(P(J),J=1,K)   
      IF(G(2).NE.0.)PRINT102,X,Y
101   FORMAT(I8,10(F9.3))
102   FORMAT(1H+,110X,2HB=,F7.4,2HD=,F7.4)    
      RETURN      
      END  
CCON2      PASS 2 FUNCTION INTERPOLATER
C    *** MUSIC V ***     
      FUNCTION CON(G,I,T)
      DIMENSION G(I)     
      DO  10 J=I,1000,2   
      IF (G(J)-T) 10,20,30      
 30   CON = G(J-1)+((T-G(J-2))/(G(J)-G(J-2)))*(G(J+1)-G(J-1))      
      RETURN      
10    CONTINUE    
20    CON = G(J+1)
      RETURN      
      END  
C      CONVT FOR UNIT GENERATORS CHECK 
C   
C      DUMMY   NO OPERATION ACTUALLY PERFORMED
C****** WHEN DUMMY IS REMOVED ANOTHER CONVT MUST!!!! BE LOADED!!!*****
C*** SUBROUTINE CONVT   
C***  COMMON IP(10),P(100),G(1000)     
C***  RETURN      
C***  END  
CERRO1     GENERAL ERROR ROUTINE
C    *** MUSIC V ***     
      SUBROUTINEERROR(I) 
      PRINT100,I  
  100 FORMAT (' ERROR OF TYPE',I5)     
      RETURN      
      END  
CC*****      SUBROUTINE PLS
CC*****      ENTRY PLS1  
CC*****      ENTRY PLS2  
CC*****      ENTRY PLS3  
CC*****      ENTRY PLS4  
CC*****      ENTRY PLS5  
CC*****      END  
      SUBROUTINE PLS1
      RETURN
      END
      SUBROUTINE PLS2
      RETURN
      END
      SUBROUTINE PLS3
      RETURN
      END
      SUBROUTINE PLS4
      RETURN
      END
      SUBROUTINE PLS5
      RETURN
      END